home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1999 March
/
EnigmA AMIGA RUN 35 (1999)(G.R. Edizioni)(IT)[!][issue 1999-03].iso
/
www
/
amitrix
/
awn_1.7.lha
/
AWebNews_1.7
/
news.awebrx
< prev
next >
Wrap
Text File
|
1996-12-24
|
36KB
|
1,336 lines
/*
$VER: AWebNews 1.7
22 Dec 1996
AWebNews the online News Reader for AWEB-II.
By William H. M. Parker <bill@amitrix.com>
All Rights Reserved DO NOT DISTRIBUTE
Plugin usage:
command sys:rexxc/rx
arguments AWeb-II:plugins/awebnews/news.awebrx %a
If you don't use an AWeb-II: assign you must use
arguments FullPath/news.awebrx %a
macro Fullpath/news.awebrx
Note: ARexx limits file name length so the use of the assign is preferred.
*/
/*Show Host first response at top of page use 'on' or 'off'*/
showstartinfo='off'
/*Show calling parameters at top of page use 'on' or 'off'*/
showcomand='off'
/* CHANGE THIS SCRIPT AND YOU COULD REGRET IT !
... rename and wildcard delete happen
... external comands are enabled
*/
options results
signal on ioerr
newsgroupsfile="newsgroups"
maxmes=0
lterm='0d'x
term='.'||'0d'x
fterm='.'||'0d'x||'0a'x
bterm='0d'x||'0a'x||'.'||'0d'x||'0a'x
ports = show('P')
parse var ports dummy 'AWEB.' portnr .
address value 'AWEB.' || portnr
'GET ACTIVEPORT'
awebhost = result
if ~show('L','rexxsupport.library') then
if ~addlib('rexxsupport.library',0,-30,0) then
exit(20)
parse arg addr
parse source prog_type result_flag called resolved ext host .
last_slash = lastpos('/',called)
last_colon = lastpos(':',called)
dir_pos = max(last_slash,last_colon)
if dir_pos > 0 then
current_dir = left(called,dir_pos)
else
current_dir = ''
address value awebhost
address command 'delete T:configawebnews.#?.html >NIL:'
if exists('t:awebnews.abort') then call delete('t:awebnews.abort')
if exists('t:awebnews.ar') then call delete('t:awebnews.ar')
fname='T:awebnews.'time(S)'.html'
call readinfo
if fun='ABORT' then call makeabort
if fun='many subjects' then do
fun='many'
spec='sub'
end
if fun='all subjects' then do
fun='all'
spec='sub'
end
if fun='Kill Subject List' then do
ft='group'
call setclip('awnsub')
end
if ft='sl' then do
ft='message'
spec='sel'
end
if ft='message' & fun='post' then ft='group'
if ft='meslist' & folu~='' then do
ft='group'
fun='post'
end
if sames='' & fun~='post' & fun ~='post' &ft~='post' then do
address command 'delete T:awebnews.#?.html >NIL:'
end
if ft='' then do
call firstinfo
parse var addr . '"' ngroup '"' .
if ngroup~=''then ft='group'
end
if many='' then many='10'
if NewsHost='' then do
call open(1,fname,w)
call writeln(1,'<html><head><title>AWebNews Error</title></head><body>')
call writeln(1,'<h1>AWebNews Error</h1>')
call writeln(1,'<b>You have not configured your NewsHost.</b><p>')
call writeln(1,'Please run ConfigNews script <br>')
call writeln(1,'<a href="x-aweb:rexx/'current_dir'confignews.awebrx">Configuration </a>')
call close(1)
'OPEN file://localhost/'fname
'SCREENTOFRONT'
exit
end
call pragma(w,n)
if ~showlist(H,'TCP') then do
call open(1,fname,w)
call writeln(1,'<html><head><title>AWebNews Error</title></head><body>')
call writeln(1,'<h1>AWebNews Error</h1>')
call writeln(1,'<b>Can not find TCP: on your system.</b><p>')
call close(1)
'OPEN file://localhost/'fname
'SCREENTOFRONT'
exit
end
if sames~='' then do
call savemes
'OPEN file://localhost/'fname
'SCREENTOFRONT'
exit
end
if fun='batch groups' then do
if open(1,fname,w) then do
call htmltop
call batchform
call htmlbottom
'OPEN file://localhost/'fname'#bpage'
'SCREENTOFRONT'
'ACTIVATEWINDOW'
'ALLOWCMD'
end
exit
end
if ft='batch' then do
call batchchecked
'OPEN file://localhost/'fname'#batch'
'SCREENTOFRONT'
exit
end
intmes='0'
if ft='message' then do
if fun = 'batch many' | fun='batch all' then do
call postinfo
call opennews
if exists(bfile)then mode='A'
else mode='W'
if open(3,bfile,mode) then do
bcount=0
errlog=''
if fun = 'batch many' then rlen= batchgroup(ngroup,many)
if fun = 'batch all' then rlen= batchgroup(ngroup,0)
call close(3)
if rlen>0 then errcode=999
end
if open(1,fname,w) then do
call htmltop
call groupform
call writeln(1,'<center><hr><a name = "batch"> </a>')
call writeln(1,'<a name = "mesl"> </a>')
call writeln(1,'<a name = "errlog"> </a>')
if errcode=999 then do
call writeln(1,'<b>Error</b><br>')
call writeln(1,'Could not open <b>'bfile'</b><br>')
end
else do
call writeln(1,'Error log <br>')
call writeln(1,'Batched 'bcount 'articles to file<b> 'bfile'</b><br>')
call writeln(1,'From 'ngroup'<br>')
if errlog~='' then call writeln(1,'</center> Batch log ' errlog '<br>')
end
call writeln(1,'<center>')
call jumps(5)
call writeln(1,'</center>')
call closenews
call messform
call htmlbottom
'OPEN file://localhost/'fname'#batch'
'SCREENTOFRONT'
'ACTIVATEWINDOW'
'ALLOWCMD'
exit
end
end
call opennews
call subscribenews (ngroup)
if fun='previous' then do
nextmes=nextmes-2
if nextmes < meslow then nextmes = meslow
end
maxmes = nextmes
if fun = 'many' then do
maxmes = nextmes + many -1
if maxmes > meshi then maxmes = meshi
end
if fun = 'all' then maxmes = meshi
if open(1,fname,w) then do
call htmltop
call groupform
if spec='sub' then call subjectnews
else do
if spec='sel' then call selheadnews
else call manyheadnews
end
call closenews
call messform
call htmlbottom
call updategroup
if spec='sub' | subkey='2' then 'OPEN file://localhost/'fname'#subl'
else 'OPEN file://localhost/'fname'#mesl'
call setclip('awebnewshome',fname)
'SCREENTOFRONT'
'ACTIVATEWINDOW'
'ALLOWCMD'
exit
end
end
/*external startup not from own html or aweb faking it*/
if ft='' then do
if open(1,fname,w) then do
call htmltop
call groupform
call htmlbottom
'OPEN file://localhost/'fname'#subscribe'
call setclip('awebnewshome',fname)
'SCREENTOFRONT'
'ACTIVATEWINDOW'
'ALLOWCMD'
end
else address command 'RequestChoice "News Reader" "Can not open t:file" "Ok" pubscreen aweb >NIL:'
end
if ft='post' then do
call opennews
call writeln(8,'post')
groupinfo = readln(8)
parse var groupinfo errcode groupinfo
if errcode < 400 then do
if open(1,fname,w) then do
call htmltop
postd = fixpostd(addr)
call writeln(8,postd)
call writeln(8,'.')
groupinfo = readln(8)
parse var groupinfo errcode groupinfo
end
call closenews
call writeln(1,'<center><hr>')
call writeln(1,'<a name = "postreply"> </a>')
if errcode > 399 then call writeln(1,'ERROR 'errcode'<br>')
else call writeln(1,'Posting completed<br>')
call writeln(1,groupinfo'<br>')
call htmlbottom
'OPEN file://localhost/'fname'#postreply'
'SCREENTOFRONT'
'ACTIVATEWINDOW'
'ALLOWCMD'
end
else address command 'RequestChoice "AWebNews " "'groupinfo'" "ERROR" pubscreen aweb >NIL:'
exit
end
else if ft='group' then do
if open(1,fname,w) then do
if fun='post' then do
page='ppage'
call htmltop
call postform
end
else do
page='messel'
call opennews
call subscribenews (ngroup)
call closenews
call htmltop
if errcode>399 then ngroup =ngroup' is NOT FOUND'
else call groupcnt
call groupform
if errcode<400 then call messform
else page='subscribe'
end
call htmlbottom
'OPEN file://localhost/'fname'#'page
call setclip('awebnewshome',fname)
'SCREENTOFRONT'
'ACTIVATEWINDOW'
'ALLOWCMD'
end
end
exit
groupform:
call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
call writeln(1,'<center><hr>')
call writeln(1,'<a name = "subscribe"></a>')
call writeln(1,'<input type="hidden" value="group" name="ft"> ')
call writeln(1,'Select NewsGroup or Enter NewsGroup Name ')
call writeln(1,'<br><tt><input size=40 name="group" value='""'></tt>')
call writeln(1,'<br><tt><select name="grouplist" size="5">')
if open(7,current_dir||newsgroupsfile,r) then do
groupinfo='.'
do while groupinfo~=""
groupinfo = readln(7)
parse var groupinfo grp list
if grp=ngroup then call writeln(1,'<option selected> 'grp)
else if grp~="" then call writeln(1,'<option> 'grp)
end
call close(7)
end
call writeln(1,'</select></tt>')
if ngroup=''then call writeln(1,'<br>No NewsGroup Set')
else call writeln(1,'<br>Currrent NewsGroup <b>' ngroup'</b>')
call writeln(1,'<br>')
call writeln(1,' <input type="submit" value="Set Current Group">')
call writeln(1,' <input type="submit" value="batch groups" name="fun">')
if ft ~='' & right(ngroup,5)~= 'FOUND' then call writeln(1,' <input type="submit" value="post" name="fun">')
call writeln(1,'<br>')
call jumps(1)
call writeln(1,'<input type="hidden" value="1" name="nmess"> ')
call hidestate 0
call writeln(1,'</center></form>')
return
messform:
call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
call writeln(1,'<center><hr>')
call writeln(1,'<input type="hidden" value="message" name="ft"> ')
call writeln(1,'<a name = "messel"></a>')
call writeln(1,'<a name="mes'intmes'"></a>')
call writeln(1,'<a name="head'intmes'"></a>')
call writeln(1,'Current NewsGroup - <b>'ngroup '</b><br>')
call writeln(1,' contains 'mescount' articles #'meslow' - #'meshi'<br>')
call writeln(1,'Next Article #<input size=7 name="nmess"value="'nextmes'"> ')
call writeln(1,'How Many ? <input size=3 name="many" value="'many'"><br> ')
call writeln(1,'<input type="submit" value="many subjects" name="fun"> ')
call writeln(1,'<input type="submit" value="all subjects" name="fun">')
call writeln(1,' <input type="submit" value="post" name="fun"><br>')
call writeln(1,'<input type="submit" value="read" name="fun"> ')
call writeln(1,'<input type="submit" value="previous" name="fun"> ')
call writeln(1,'<input name="fun" type="submit" value="many">')
call writeln(1,' <input name="fun" type="submit" value="all">')
call writeln(1,' --<input type="submit" value="ABORT" name="fun">--<br>')
call scnfg(1)
call writeln(1,'<input name="fun" type="submit" value="batch many"> ')
call writeln(1,' <input name="fun" type="submit" value="batch all">')
call writeln(1,' <input type="submit" value="batch groups" name="fun"><br>')
call jumps(3)
call hidestate 1
call writeln(1,'</center></form>')
return
htmltop:
call writeln(1,'<html><head><title>')
call writeln(1,'AWebNews Reader')
call writeln(1,'</title></head>')
if colo='on' then call writeln(1,'<body bgcolor="'bacc'" text="'texc'">')
if showcomand='on' then call writeln(1,addr '<br>')
if showstartinfo='on' then call writeln(1,startinfo)
return
htmlbottom:
call writeln(1, '<hr></body></html>')
call close(1)
return
readinfo:
parse var addr . 'colo="' colo '"' .
parse var addr . 'bacc="' bacc '"' .
parse var addr . 'texc="' texc '"' .
parse var addr . 're-' folu '-' .
parse var addr . 'sa-' sames '-' .
parse var addr . 'host="' NewsHost '"' .
parse var addr . 'nmess="' nextmes '"' .
parse var addr . 'ft="' ft '"' .
parse var addr . 'group="' ngroup '"' .
if ngroup='' then parse var addr . 'grouplist="' ngroup '"' .
ngroup=TRANSLATE(ngroup,xrange('a','z'), xrange('A','Z'))
parse var addr . 'fun="' fun '"' .
parse var addr . 'many="' many '"' .
parse var addr . 'sho="' sho '"' .
parse var addr . 'lho="' lho '"' .
parse var addr . 'xprt="' xprt '"' .
parse var addr . 'fcase="' fcase '"' .
phil=fixphil(addr);
parse var addr . 'philo="' philo '"' .
parse var addr . 'scan="' scan '"' .
return
opennews:
call openpro
call writeln(con,'Waiting for Host')
if ~ open(8,'tcp:'NewsHost'/119',w) then do
address command 'RequestChoice "AWebNews " "Can Not Open Host 'NewsHost'" "Ok" pubscreen aweb >NIL:'
exit
end
startinfo = readln(8)
parse var startinfo errcode startinfo
call writeln(con,startinfo)
return
closenews:
call writeln(8,'QUIT')
call close(8)
if progo='o' then call close(con)
progo=''
return
subscribenews:
parse arg tgroup
call writeln(8,'group 'tgroup)
groupinfo = readln(8)
call writeln(con,'0c'x ngroup )
parse var groupinfo errcode mescount meslow meshi .
return 0
manyheadnews:
if nextmes < meslow then return
if nextmes > meshi then return
errlog=''
oldnextmes=nextmes
call meslisttop
call writeln(con,' ' )
do while nextmes <= maxmes
if exists('T:AWebNews.ABORT') then do
if tryabort()="" then do
maxmes=nextmes
errlog=errlog||'<br> ABORT at ' nextmes '<br>'
end
end
call headnews
nextmes = nextmes + 1
end
call writeln(1,'<hr><b>' ngroup '</b> Article Texts' )
call writeln(1,'-<a href="file://localhost/'current_dir'AWebNews_doc.html#form_scan_ng">Help</a>')
call writeln(1,' - <a href="#errlog" >error log</a>')
call mesnews
call writeln(1,'<hr><a name="errlog"></a><center>')
call jumps(0)
call writeln(1,'Error Log</center>')
if errlog~='' then call writech(1,errlog)
else call writech(1,'No Errors ')
call meslistbottom
return
meslisttop:
call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
call writeln(1,'<a name="mesl"></a>')
call writeln(1,'<input type="hidden" value="meslist" name="ft"> ')
if scan='on' then do
call writeln(1,'<hr><b> ' ngroup '</b> article Index List</b>' )
call writeln(1,'-<a href="file://localhost/'current_dir'AWebNews_doc.html#form_scan_ng">Help</a>')
call writeln(1,' - <a href="#errlog" >error log</a>')
end
return
meslistbottom:
call hidestate 0
call writeln(1,'</form>')
return
groupcnt:
if ~open(7,current_dir||newsgroupsfile,r) then call open(7,current_dir||newsgroupsfile,w)
do
groupinfo = readln(7)
parse var groupinfo grp cnt .
do while grp~ = ngroup & groupinfo ~= ''
groupinfo = readln(7)
parse var groupinfo grp cnt .
end
if grp=ngroup then nextmes = cnt
else call writeln(7,ngroup meslow)
call close(7)
end
if nextmes='' | nextmes < meslow then nextmes = meslow
return
updategroup:
if open(6,current_dir||newsgroupsfile'.new',w) then do
if open(7,current_dir||newsgroupsfile,r) then do
do until groupinfo = ''
groupinfo = readln(7)
parse var groupinfo grp cnt xtra .
if ft='batch' then do
if grp = ngroup then call writeln(6,grp nextmes ' batch')
else if grp~='' then call writeln(6,grp cnt xtra)
end
else do
if grp = ngroup then call writeln(6,grp nextmes xtra)
else if grp~='' then call writeln(6,grp cnt xtra)
end
end
call close(7)
end
call close(6)
if exists(current_dir||newsgroupsfile) then call delete(current_dir||newsgroupsfile)
call rename(current_dir||newsgroupsfile'.new', current_dir||newsgroupsfile)
end
return
cleargroup:
if open(6,current_dir||newsgroupsfile'.new',w) then do
if open(7,current_dir||newsgroupsfile,r) then do
do until groupinfo = ''
groupinfo = readln(7)
parse var groupinfo grp cnt xtra
if grp~='' then call writeln(6,grp cnt )
end
call close(7)
end
call close(6)
if exists(current_dir||newsgroupsfile) then call delete(current_dir||newsgroupsfile)
call rename(current_dir||newsgroupsfile'.new', current_dir||newsgroupsfile)
end
return
firstinfo:
if open(2,current_dir||'newsconfig',r) then do
configinfo = readch(2,3000)
parse var configinfo . 'colo ' colo '0a'x
parse var configinfo . 'texc ' texc '0a'x
parse var configinfo . 'bacc ' bacc '0a'x
parse var configinfo . 'bfile ' bfile '0a'x
parse var configinfo . 'host ' NewsHost '0a'x
parse var configinfo . 'many ' many '0a'x
parse var configinfo . 'sho ' sho '0a'x
parse var configinfo . 'lho ' lho '0a'x
parse var configinfo . 'scan ' scan '0a'x
parse var configinfo . 'phil ' phil '0a'x
parse var configinfo . 'philo ' philo '0a'x
parse var configinfo . 'fcase ' fcase '0a'x
call close(2)
end
return
postform:
call postinfo
call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
call writeln(1,'<a name="ppage"></a>')
call writeln(1,'<input type="hidden" value="post" name="ft"> ')
call writeln(1,'<hr><a name = "messel"> </a>')
call writeln(1,'<center>Post an Article')
call writeln(1,'-<a href="file://localhost/'current_dir'AWebNews_doc.html#form_post">Help</a>')
call writeln(1,'<textarea name="postd" cols='taw' rows='tah'>')
subject=''
from=''
mdate=''
if folu~='' then do
call opennews
call subscribenews (ngroup)
call writeln(8,'head ' folu)
mesinfo = readln(8)
parse var mesinfo errcode mesinfo
if errcode <400 then do
do until scaninfo = term
scaninfo = readln(8)
if subject='' then parse var scaninfo . 'Subject:' subject '0d'x
if from='' then parse var scaninfo . 'From:' from '0d'x
if mdate='' then parse var scaninfo . 'Date:' mdate '0d'x
end
end
if left(subject,3) ~= ' re' & left(subject,3) ~= ' Re' then subject =' Re:'subject
end
call writeln(1,'NewsGroups: 'ngroup)
if disto='on' then call writeln(1,'Distribution: 'disth)
if heado='on' then do
if open(3,headf,r) then do
do until headinfo = ''
headinfo=readln(3)
if headinfo~="" then call writeln(1,fixhtml(headinfo))
end
call close(3)
end
end
call writeln(1,'X-Newsreader: AWebNews ')
if repo='on' then call writeln(1,'Reply-To: 'fixhtml(reph))
call writeln(1,'From: 'fixhtml(eadr))
call writeln(1,'Subject:'fixhtml(subject) )
call writeln(1,'' )
call writeln(1,'--' )
if folu~='' then do
call writeln(1,'On 'mdate', 'fixhtml(from)' wrote ...' )
if qhead='on'then do
call writeln(8,'head ' folu)
mesinfo = readln(8)
parse var mesinfo errcode mesinfo
if errcode <400 then do
do until scaninfo = term
scaninfo = readln(8)
if scaninfo ~= term then call writeln(1,' > 'fixhtml(scaninfo))
end
end
end
if qbody='on'then do
call writeln(8,'body ' folu)
mesinfo = readln(8)
parse var mesinfo errcode mesinfo
if errcode <400 then do
do until scaninfo = term
scaninfo = readln(8)
if scaninfo ~= term then call writeln(1,' > 'fixhtml(scaninfo))
end
end
end
call writeln(1,'--' )
end
if sigo='on' then do
if open(3,sigf,r) then do
do until siginfo = ''
siginfo=readln(3)
call writeln(1,fixhtml(siginfo))
end
call close(3)
end
end
call writeln(1,'</textarea>')
call hidestate 0
call writeln(1,'<input type="submit" value="Post Article"></form>')
return
postinfo:
if open(2,current_dir||'newsconfig',r) then do
configinfo = readch(2,3000)
parse var configinfo . 'bfile ' bfile '0a'x
parse var configinfo . 'eadr ' eadr '0a'x
parse var configinfo . 'disto ' disto '0a'x
parse var configinfo . 'disth ' disth '0a'x
parse var configinfo . 'repo ' repo '0a'x
parse var configinfo . 'reph ' reph '0a'x
parse var configinfo . 'sigo ' sigo '0a'x
parse var configinfo . 'sigf ' sigf '0a'x
parse var configinfo . 'heado ' heado '0a'x
parse var configinfo . 'headf ' headf '0a'x
parse var configinfo . 'qhead ' qhead '0a'x
parse var configinfo . 'qbody ' qbody '0a'x
parse var configinfo . 'tah ' tah '0a'x
parse var configinfo . 'taw ' taw '0a'x
parse var configinfo . 'spath ' spath '0a'x
call close(2)
end
return
savemes:
call postinfo
address command ' requestfile >t:awebnews.ar savemode 'spath' file 'ngroup'.'sames' title "AWebNews Article Save" positive SAVE pubscreen aweb'
if rc>0 then exit
call open(3,'t:awebnews.ar',r)
savename=readch(3,300)
call close(3)
parse var savename '"' savename '"'
if open(3,savename,w) then do
call opennews
call subscribenews (ngroup)
if readtostr(article,sames)>0 then call writech(3,left(scaninfo,length(scaninfo)-3))
call closenews
call close(3)
end
else do
errcode=999
mesinfo='Could not open <b> 'savename'</b>'
end
if open(1,fname,w) then do
call htmltop
if errcode>399 then do
call writeln(1,'<h1>AWebNews Error</h1>')
call writeln(1,'<b>Article not saved</b><p>')
call writeln(1,mesinfo'<p>')
end
else
call writeln(1,'<h2> Article Saved O.K.</h2><p>')
call writeln(1,savename '<p>')
end
call htmlbottom
return
readtostr:
parse arg comtype,temp
call writeln(8,comtype' 'temp)
mesinfo = readln(8)
parse var mesinfo errcode mesinfo
if errcode>399 then return 0
scaninfo=""
do until lineinfo=term
lineinfo = readln(8)
scaninfo = scaninfo||lineinfo
end
scaninfo= TRANSLATE(scaninfo,'0a'x , '0d'x )
return length(scaninfo)
batchgroup:
parse arg tgroup,btemp
ngroup =tgroup
call subscribenews(tgroup)
call writeln(con,' ' )
if errcode<400 then do
if nextmes='' then call groupcnt
if btemp=0 then maxmes = meshi
else maxmes = nextmes + btemp - 1
if maxmes > meshi then maxmes = meshi
if nextmes<=maxmes then errlog=errlog||'<br>'tgroup' o.k., getting 'nextmes'- 'maxmes
else errlog=errlog||'<br>'tgroup' o.k., no articles'
btemp=0
do while nextmes<=maxmes
call writeln(con,'9b41'x maxmes - nextmes +1 ' ')
if exists('T:AWebNews.ABORT') then do
if tryabort()="" then do
maxmes=nextmes
listwork=''
errlog=errlog||'<br> ABORT at ' nextmes '<br>'
end
end
rlen = readtostr(article,nextmes)
if philo='on' & filter(scaninfo)=0 then do
rlen=0
mesinfo='filtered out'
end
if rlen > 0 then do
call = writeln(3,'#! rnews' length(scaninfo)-2)
rlen= writech(3,left(scaninfo,length(scaninfo)-2))
end
else errlog=errlog||'<br> - 'tgroup||' 'nextmes' '||mesinfo
nextmes=nextmes+1
btemp=btemp+1
end
bcount=bcount+btemp
call updategroup
return 0
end
else errlog=errlog||'<br>NO GROUP 'tgroup||' '||groupinfo
return 1
fixhtml: procedure
parse arg a
a=a'-'
c=''
parse var a b '&' a
do while a~=''
c=c||b'&'
parse var a b '&' a
end
a=c||b
c=''
parse var a b '<' a
do while a~=''
c=c||b'<'
parse var a b '<' a
end
a=c||b
c=''
parse var a b '>' a
do while a~=''
c=c||b'>'
parse var a b '>' a
end
a=c||b
return left(a,length(a)-1)
fixta: procedure
parse arg a
a=fixhtml(a)
a=a'-'
c=''
parse var a b '"' a
do while a~=''
c=c||b'"'
parse var a b '&' a
end
a=c||b
return left(a,length(a)-1)
batchform:
call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
call writeln(1,'<a name="bpage"></a>')
call writeln(1,'<hr><center>')
call writeln(1,'Select NewsGroups to Batch')
call writeln(1,'<br><select multiple name="grouplist" size="5">')
if open(7,current_dir||newsgroupsfile,r) then do
groupinfo='.'
do while groupinfo~=""
groupinfo = readln(7)
parse var groupinfo grp tmes bstat list
if grp~="" then do
if bstat ='batch' then call writeln(1,'<option selected> 'grp)
else call writeln(1,'<option> 'grp)
end
end
call close(7)
end
call writeln(1,'</select><br>')
call writeln(1,' <input type="submit" value="batch checked groups">')
call writeln(1,' --<input type="submit" value="ABORT" name="fun">--<br>')
call scnfg(0)
call writeln(1,'<input type="hidden" value="batch" name="ft"> ')
call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#form_batch_ng">Help</a> - ')
call writeln(1,'<a href="x-aweb:rexx/'current_dir'news.awebrx">Read News </a>')
call writeln(1,' - <a href="x-aweb:rexx/'current_dir'confignews.awebrx">Config / Maintain Groups </a>')
call hidestate 0
call writeln(1,'</form>')
return
batchchecked:
call postinfo
call cleargroup
if exists(bfile) then mode='A'
else mode='W'
if open(3,bfile,mode) then do
bcount=0
errlog=''
call opennews
listwork=addr
do until nextgrp=''
parse var listwork . 'grouplist="' nextgrp '"' listwork
if nextgrp~='' then do
nextmes=''
call batchgroup(nextgrp,0)
end
end
call closenews
call close(3)
end
else errcode =999
if open(1,fname,w) then do
call htmltop
call batchform
call writeln(1,'<hr><a name = "batch"></a><center>Error log<br>')
if errcode=999 then do
call writeln(1,'<b>Error</b><br>')
call writeln(1,'Could not open 'bfile'<br>')
end
else do
call writeln(1,'Batched 'bcount 'articles to file <b>'bfile'</b><br>')
call writeln(1,'From Selected Groups</center>')
if errlog~=''then call writeln(1,'<br> Batch log'errlog '<br>')
end
call writeln(1,'<center>')
call jumps(6)
call writeln(1,'</center>')
call htmlbottom
end
return
headnews:
if spec='sel' then call writeln(con,'9b41'x nextmes ' ')
else call writeln(con, '9b41'x maxmes-nextmes+1 ' ')
rlen= readtostr(article,nextmes)
if philo='on' & filter(scaninfo)=0 then do
errcode=888
mesinfo='filtered out'
end
if errcode<400 then do
mesfound='y'
scaninfo=makelink(fixhtml(scaninfo))
call setclip('awebnews_'nextmes,scaninfo)
if scan='on' then do
parse var scaninfo scaninfo '0a0a'x bodyinfo
parse var scaninfo 'Reply-To:' reply '0a'x
parse var scaninfo 'Subject:' subject '0a'x
parse var scaninfo 'From:' from '0a'x
parse var scaninfo 'Date:' mdate '0a'x
call writeln(1,'<hr><center>')
call writeln(1,' #'nextmes)
call writeln(1,' - <a href="#mes'intmes'" >read</a>')
call writeln(1,' - <a href="#head'intmes+1'" name="head'intmes'">next</a>')
if intmes>0 then call writeln(1,' - <a href="#head'intmes-1'" >previous</a>')
call writeln(1,' - <a href="#mesl" >top</a> - <a href="#messel"> more</a>')
call writeln(1,' - <input type="submit" value="follow up" name="re-'nextmes'-">')
call writeln(1,' - <input type="submit" value="save" name="sa-'nextmes'-">')
intmes=intmes+1
call writeln(1,'<br>')
call writeln(1,'</center>')
call writeln(1,' Subject : 'subject'<br>')
call writeln(1,' Date : 'mdate'<br>')
if reply~=''then do
call writeln(1,'Reply-To: <A HREF="mailto:'fixmailto(reply)'"><I>'reply'</I></A><BR>')
call writeln(1,' From: 'from)
end
else call writeln(1,'From: <A HREF="mailto:'fixmailto(from)'"><I>'from'</I></A>')
end
end
else errlog=errlog||'Article not found 'nextmes' 'mesinfo'<br>'
return
mesnews:
if mesfound~='y' then do
call writeln(1,' No articles retreived.<br>')
return
end
intmes=0
clips= show('C')
call writeln(con,'0c'x 'processing')
do while clips~=''
parse var clips 'awebnews_' clipmes clips
if clipmes~='' then do
call writech(con,'.')
scaninfo= getclip('awebnews_'clipmes)
parse var scaninfo scaninfo '0a0a'x bodyinfo
call writeln(1,'<hr> <center># 'clipmes )
if scan ='on' then call writeln(1,' - <a href="#head'intmes'" >Index</a>')
call writeln(1,' - <a href="#mes'intmes+1'" name="mes'intmes'">next</a>')
if intmes>0 then call writeln(1,' - <a href="#mes'intmes-1'" >previous</a>')
call writeln(1,' - <a href="#mesl" >top</a> - <a href="#messel"> more</a>')
call writeln(1,' - <input type="submit" value="follow up" name="re-'clipmes'-">')
call writeln(1,' - <input type="submit" value="save" name="sa-'clipmes'-">')
intmes=intmes+1
call writeln(1,'</center>')
if sho='on'then do
parse var scaninfo 'Reply-To: ' reply '0a'x
parse var scaninfo 'Subject:' subject '0a'x
parse var scaninfo 'From:' from '0a'x
parse var scaninfo 'Date:' mdate '0a'x
call writeln(1,' Subject : 'subject'<br>')
call writeln(1,' Date : 'mdate'<br>')
if reply~=''then do
call writeln(1,'Reply-To: <A HREF="mailto:'fixmailto(reply)'"><I>'reply'</I></A><BR>')
call writeln(1,' From: 'from)
end
else call writeln(1,'From: <A HREF="mailto:'fixmailto(from)'"><I>'from'</I></A>')
end
if lho='on' then do
call writeln(1,'<pre >')
call writeln(1,scaninfo)
call writeln(1,'</pre>' )
end
call writeln(1,'<br><pre>')
if sho~='on' & h~='on' then do
parse var scaninfo 'Subject:' subject '0a'x
call writeln(1,' Subject : 'subject)
end
if length(bodyinfo)>2 then call writeln(1,left(bodyinfo,length(bodyinfo)-2))
call writeln(1,'</pre>' )
call setclip('awebnews_'clipmes)
end
end
return
fixpostd: procedure
parse arg a
c=''
parse var a b '*"' a
do while a~=''
c=c||b'*q'
parse var a b '*"' a
end
a=c||b
parse var a . 'postd="' a '"' .
c=''
parse var a b '*' a
do while a~=''
d=left(a,1)
if d='N' then c=c||b||'0a'x
else if d='q' then c=c||b||'"'
else if d='"'|d='*'|d="'"|d='$'then c=c||b||d
else do
c=c||b||'*'
a=d||a
end
parse VALUE (substr(a,2)) WITH b '*' a
end
return c||b
fixphil: procedure
parse arg a
c=''
parse var a b '*"' a
do while a~=''
c=c||b'*q'
parse var a b '*"' a
end
a=c||b
parse var a . 'phil="' a '"' .
c=''
parse var a b '*' a
do while a~=''
d=left(a,1)
if d='N' then c=c||b||'0a'x
else if d='q' then c=c||b||'"'
else if d='"'|d='*'|d="'"|d='$'then c=c||b||d
else do
c=c||b||'*'
a=d||a
end
parse VALUE (substr(a,2)) WITH b '*' a
end
return c||b
ioerr:
address command 'RequestChoice "AWebNews " "'NewsHost' not responding" "Ok" pubscreen aweb >NIL:'
exit
openpro:
if progo='o' then call close(con)
call open(con,'con://300/50/AWebNews ' NewsHost'/close/inactive/screen aweb')
progo='o'
return
filtersubjects:
procedure expose phil fcase
parse arg a
c=''
do while a~=''
parse var a b '0a'x a
if filter(b) =1 then c=c||b||'0a'x
end
return c
subjectnews:
call writeln(con,'Subjects ' maxmes-nextmes+1)
rlen= readtostr('xhdr Subject',nextmes'-'maxmes)
if errcode<400 then do
if philo='on' then scaninfo=filtersubjects(scaninfo)
scaninfo=fixhtml(scaninfo)
if ngroup=getclip('awnoldngroup')then scaninfo=getclip('awnsub')||scaninfo
call setclip('awnsub',left(scaninfo,length(scaninfo)-2))
call setclip('awnoldngroup',ngroup)
nextmes = maxmes+1
call updategroup
call subjectform
end
return
subjectform:
scaninfo=getclip('awnsub')
call writeln(1,'<form action="x-aweb:rexx/'||called||'">')
call writeln(1,'<center><hr><a name = "subl"></a>')
if scaninfo='' then do
call writeln(1,'No articles in subject list.<br>')
end
else do
call writeln(1,' <a name="mes'intmes'"></a>')
call writeln(1,' <a name="mes'intmes'"></a>')
call writeln(1,'Subjects from articles in <b>' ngroup'</b>')
call writeln(1,'<br><select multiple name="sublist" size="10">')
do while scaninfo~=''
parse var scaninfo subject '0a'x scaninfo
if subject~='.'then call writeln(1,'<option> 'left(subject,75))
end
call writeln(1,'</select><br>')
call writeln(1,' <input type="submit" value="Read selected articles" name="fun">')
call writeln(1,' <input type="submit" value="Read all articles" name="fun">')
call writeln(1,' --<input type="submit" value="ABORT" name="fun">--<br>')
call writeln(1,' <input type="submit" value="Kill selected articles" name="fun">')
call writeln(1,' <input type="submit" value="Kill Subject List" name="fun"><br>')
call scnfg(1)
end
call jumps(2)
call writeln(1,'<input type="hidden" name="ft" value="sl">')
call hidestate 1
call writeln(1,'<center></form>')
return
selheadnews:
errlog=''
oldnextmes=nextmes
subt=getclip('awnsub')
if fun='Read selected articles' then do
parse var addr subs
subkey='0'
end
if fun='Read all articles' then do
subkey='1'
subs=subt
end
if fun='Kill selected articles' then do
subkey='2'
parse var addr subs
end
if subkey~='2' then call meslisttop
call writeln(con,' ' )
do while subs~=''
if subkey='1' then parse var subs nextmes . '0a'x subs
else parse var subs . 'sublist="'nextmes ' ' subs
parse var subt subt (nextmes) '0a'x subtt
subt=subt||subtt
if exists('T:AWebNews.ABORT') then do
if tryabort()="" then do
subs=''
errlog=errlog||'<br> ABORT at ' nextmes '<br>'
end
end
if nextmes~='' & subkey~='2' then call headnews
end
call setclip('awnsub',subt)
nextmes=oldnextmes
if subkey~='2' then do
call writeln(1,'<hr><b>' ngroup '</b> Selected Texts' )
call writeln(1,'- <a href="file://localhost/'current_dir'AWebNews_doc.html#form_scan_ng">Help</a>')
call writeln(1,' - <a href="#errlog" >error log</a>')
call mesnews
call writeln(1,'<hr><a name="errlog"></a><center>')
call jumps(4)
call writeln(1,'Error Log</center>')
if errlog~='' then call writech(1,errlog)
else call writech(1,'No Errors ')
call meslistbottom
end
call subjectform
return
hidestate:
parse arg jt
call writeln(1,'<input type="hidden" name="colo" value="'colo'">')
call writeln(1,'<input type="hidden" name="bacc" value="'bacc'">')
call writeln(1,'<input type="hidden" name="texc" value="'texc'">')
call writeln(1,'<input type="hidden" value="'NewsHost'" name="host"> ')
call writeln(1,'<input type="hidden" value="'many'" name="many"> ')
if jt~=1 then do
call writeln(1,'<input type="hidden" value="'fcase'" name="fcase"> ')
call writeln(1,'<input type="hidden" value="'phil'" name="phil"> ')
call writeln(1,'<input type="hidden" value="'philo'" name="philo"> ')
call writeln(1,'<input type="hidden" value="'sho'" name="sho"> ')
call writeln(1,'<input type="hidden" value="'lho'" name="lho"> ')
call writeln(1,'<input type="hidden" value="'scan'" name="scan"> ')
end
call writeln(1,'<input type="hidden" value="'ngroup'" name="group"> ')
call writeln(1,'<input type="hidden" value="'nextmes'" name="nmess"> ')
return
makelink: procedure
parse arg a
c=''
do while a~=''
parse var a d 'http://' b a
c=c||d
if b~='' then do
t= length(b)
parse var b b '0a'x d
c=c|| '<a href="http://' || b || '">http://' || b || '</a>'
if length(b)~=t then c= c || '0a'x || d
end
end
return c
filter: procedure expose phil fcase
parse arg t
t=upper(t)
a=phil
if fcase='on' then a=upper(a)
do until a=''
parse var a b ',' a
if left(b,1)='-' then do
if index(t,right(b,length(b)-1))>0 then t=''
end
if left(b,1)='+' then do
if index(t,right(b,length(b)-1))=0 then t=''
end
if left(b,1)='|' then do
if t~='' then return 1
parse arg t
if fcase='on' then t=upper(t)
end
if left(b,1)='~' then do
if t='' then do
parse arg t
if fcase='on' then t=upper(t)
end
else t=''
end
end
if t~='' then return 1
return 0
scnfg:
parse arg st
call writeln(1,'<hr width =50%>')
if st=1 then do
if scan = 'on' then call writeln(1,'Index List<input type="checkbox" checked name="scan"> ')
else call writeln(1,'Index List <input type="checkbox" name="scan"> ')
if sho = 'on' then call writeln(1,'Short Header <input type="checkbox" checked name="sho"> ')
else call writeln(1,'Short Header <input type="checkbox" name="sho"> ')
if lho = 'on' then call writeln(1,'Long Header <input type="checkbox" checked name="lho"> ')
else call writeln(1,'Long Header <input type="checkbox" name="lho"> ')
call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#display"> Help</a>')
call writeln(1,'<br>')
end
call writeln(1,'Filter <input size=30 name="phil" value="'fixta(phil)'">')
if fcase = 'on' then call writeln(1,' Ignore Case <input type="checkbox" checked name="fcase"> ')
else call writeln(1,' Ignore Case <input type="checkbox" name="fcase"> ')
if philo = 'on' then call writeln(1,' Use Filter <input type="checkbox" checked name="philo"> ')
else call writeln(1,' Use Filter <input type="checkbox" name="philo">')
call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#filter"> Help </a>')
call writeln(1,'<br>')
return
jumps:
parse arg jt
if jt=1 then call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#form_select_ng">Help</a>-')
if jt=3 then call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#form_curr_ng">Help</a>-')
if jt=2 then call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#form_subject">Help</a>-')
if jt=4 | jt=0 | jt=5 | jt=6 then call writeln(1,'<a href="file://localhost/'current_dir'AWebNews_doc.html#error_log">Help</a>-')
if jt=6 then call writeln(1,'<a href="#bpage" > Batch Groups</a> - ')
if jt~=1 & jt~=6 then call writeln(1,'<a href="#subscribe" > New Group</a> - ')
if ft='message' then do
if spec='sub' | spec='sel' then do
if jt~=2 then call writeln(1,'<a href="#subl">Subjects</a> - ')
end
if spec~='sub' then do
if left(fun,5)~='batch' then call writeln(1,'<a href="#mesl"> Article Texts</a> - ')
end
if jt~=3 then call writeln(1,'<a href="#messel"> Get More Articles</a> - ')
end
if ft='group' & right(ngroup,5)~= 'FOUND' then do
if jt~=3 then call writeln(1,'<a href="#messel"> Get Articles</a> - ')
end
call writeln(1,'<a href="x-aweb:rexx/'current_dir'confignews.awebrx">Config / Maintain Groups </a><br>')
return
tryabort:
procedure
call delete('t:awebnews.abort')
address command ' requestchoice AWebNews "Abort Request" Continue Abort pubscreen aweb >t:awebnews.ar'
call open(2,'t:awebnews.ar',r)
t=readch(2,1)
call close(2)
if t='0' then return('')
return (1)
makeabort:
procedure
if open(1,'t:AWebNews.ABORT',w) then call close(1)
exit
fixmailto:
procedure
parse arg a
parse var a '<' b '>'
if b~='' then return b
c=a
do while a~=''
parse var a b a
if index(b,'@')>0 then return b
end
return strip(c)